home *** CD-ROM | disk | FTP | other *** search
/ Gamers Delight 2 / Gamers Delight 2.iso / Aminet / game / gag / MouseMagic.lha / MouseMagic / source / MouseMagic.mod < prev   
Text File  |  1991-09-19  |  4KB  |  128 lines
  1. (****************************************************************************
  2. **                                       **
  3. **  ##     ##  #####  ##   ##  ##### #####  #   #  ##   ### ###  ###       **
  4. **  ###   ### ##   ## ##   ## ##     ##     ## ## #  # #     #  #          **
  5. **  #### #### ##   ## ##   ##  ####  ####   # # # #### #  #  #  #          **
  6. **  ## ### ## ##   ## ##   ##     ## ##     #   # #  #  ### ###  ###       **
  7. **  ##  #  ##  #####   #####  #####  #####                                 **
  8. **                                       **
  9. **  written by: Robert Brandner/Schillerstr.3/A-8280 Fürstenfeld/AUSTRIA   **
  10. **                                       **
  11. **  This program is written in Modula-II using the compiler M2Amiga V3.3d  **
  12. **                                       **
  13. ****************************************************************************)
  14.  
  15. MODULE MouseMagic;
  16.  
  17. IMPORT Intuition;
  18. FROM Intuition IMPORT IntuitionBasePtr, WindowPtr, IDCMPFlags, IntuiMessagePtr,
  19.      ModifyIDCMP, IDCMPFlagSet;
  20. FROM Graphics IMPORT GetSprite, FreeSprite, ChangeSprite, SimpleSprite,
  21.      MoveSprite;
  22. FROM Exec IMPORT AllocMem, MemReqSet, MemReqs, FreeMem, CopyMem, GetMsg,
  23.      ReplyMsg;
  24. FROM SYSTEM IMPORT ADR, ADDRESS, INLINE;
  25. FROM Dos IMPORT Delay;
  26. FROM Arts IMPORT Error;
  27. FROM Windows IMPORT OpenWindow, CloseWindow, WinGad, WinGadSet;
  28.  
  29. (* PointerHeight maximal 40: *)
  30.  
  31. CONST PSIZE = 2*2*(2+40);
  32.  
  33. VAR sprite : ARRAY[0..6] OF SimpleSprite;
  34.     num : ARRAY[0..6] OF INTEGER;
  35.     mem : ARRAY[0..6] OF ADDRESS;
  36.     msg : IntuiMessagePtr;
  37.     w : WindowPtr;
  38.     ib : IntuitionBasePtr;
  39.     i : INTEGER;
  40.     cl : IDCMPFlagSet;
  41.     end : BOOLEAN;
  42.     x, y : ARRAY[0..6] OF INTEGER;
  43.  
  44. BEGIN
  45.   OpenWindow(w,350,0,150,10,"Mouse",WinGadSet{closing,moving,arranging});
  46.   IF w=NIL THEN Error(ADR("No window..."), NIL) END;
  47.   ModifyIDCMP(w, IDCMPFlagSet{closeWindow});
  48.   ib := ADR(Intuition);
  49.   FOR i := 0 TO 6 DO
  50.     num[i] := GetSprite(ADR(sprite[i]), -1);
  51.     IF num[i]#-1 THEN
  52.       sprite[i].height := ib^.aPtrHeight;
  53.       mem[i] := AllocMem(PSIZE, MemReqSet{chip, memClear});
  54.       IF mem[i]=NIL THEN
  55.  
  56.         (* Kein Speicher -> Sprite wieder freigeben: *)
  57.  
  58.         num[i] := -1;
  59.         FreeSprite(num[i])
  60.       ELSE
  61.  
  62.         (* Gleiche Grafik und Position wie Mauszeiger: *)
  63.  
  64.         CopyMem(ib^.aPointer, mem[i], (ib^.aPtrHeight)*4+4);
  65.         ChangeSprite(NIL, ADR(sprite[i]), mem[i]);
  66.         x[i] := ib^.mouseX/2-256+INTEGER(ib^.aXOffset);
  67.         y[i] := ib^.mouseY/2-256+INTEGER(ib^.aYOffset);
  68.       END
  69.     END;
  70.   END;
  71.   IF num[0]=-1 THEN Error(ADR("No Sprite free"),
  72.                           ADR("So program has no use anyhow")) END;
  73.  
  74.   LOOP
  75.     msg := GetMsg(w^.userPort);
  76.     IF msg#NIL THEN
  77.       cl :=msg^.class;
  78.       ReplyMsg(msg);
  79.       IF closeWindow IN cl THEN EXIT END;
  80.     END;
  81.     FOR i := 5 TO 0 BY -1 DO
  82.  
  83.       (* Alle Positionen um eins weiterreichen, und Grafik aktualisieren. *)
  84.  
  85.       x[i+1] := x[i]; y[i+1] := y[i];
  86.       IF num[i+1]#-1 THEN
  87.         CopyMem(ib^.aPointer, mem[i+1], (ib^.aPtrHeight)*4+4);
  88.         sprite[i+1].height := ib^.aPtrHeight;
  89.         ChangeSprite(NIL, ADR(sprite[i+1]), mem[i+1]);
  90.       END;
  91.     END;
  92.  
  93.     (* Für erstes Sprite die Position und Grafik aktualisieren. *)
  94.  
  95.     x[0] := ib^.mouseX/2-256+INTEGER(ib^.aXOffset);
  96.     IF ib^.aYOffset=0 THEN
  97.       y[0] := ib^.mouseY/2
  98.     ELSE
  99.       y[0] := ib^.mouseY/2-256+INTEGER(ib^.aYOffset)
  100.     END;
  101.     CopyMem(ib^.aPointer, mem[0], (ib^.aPtrHeight)*4+4);
  102.     sprite[0].height := ib^.aPtrHeight;
  103.     ChangeSprite(NIL, ADR(sprite[0]), mem[0]);
  104.  
  105.     (* Warten damit die Sprites etwas auseinander liegen. *)
  106.  
  107.     Delay(1);
  108.  
  109.     (* Alle Sprites an neuer Position darstellen. *)
  110.  
  111.     FOR i := 0 TO 6 DO
  112.       IF num[i]#-1 THEN
  113.         MoveSprite(NIL, ADR(sprite[i]), x[i], y[i]);
  114.       END;
  115.     END;
  116.   END;
  117.  
  118.  (* Belegte Sprites und Speicher freigeben. *)
  119.  
  120.   CloseWindow(w);
  121.   FOR i := 0 TO 6 DO
  122.     IF num[i]#-1 THEN
  123.       FreeSprite(num[i]);
  124.       FreeMem(mem[i], PSIZE);
  125.     END
  126.   END
  127. END MouseMagic.
  128.